﻿{ ******************************************************* }
{ }
{ DelphiWebMVC 5.0 }
{ E-Mail:pearroom@yeah.net }
{ 版权所有 (C) 2022-2 苏兴迎(PRSoft) }
{ }
{ ******************************************************* }
unit MVC.App;
{$I mvc.inc}

interface

uses
  System.SysUtils, System.Variants, System.Rtti, System.Classes, Web.HTTPApp,
  System.DateUtils, System.StrUtils, System.Generics.Collections, IdURI,
  Web.WebReq, MVC.Config, MVC.Route, IniFiles, MVC.Net, MVC.LogUnit, MVC.TplUnit,
  {$IFDEF MSWINDOWS} Winapi.Windows, MVC.WINServer, {$IFDEF SERVICE}
  Vcl.SvcMgr, {$ELSE} Vcl.Forms, {$ENDIF}{$ENDIF}
  MVC.HttpMmt, MVC.JSON, MVC.DM;

type
  TMVCApp = class
  private
  public
    {$IFDEF MSWINDOWS}
    Service: TMVCWinService;
    {$ENDIF}
    procedure Run(password: string = ''; BasePath: string = '');
    procedure ReadIni(BasePath: string); // 读取配置文件
    function Command: boolean;
    procedure Start(password: string = ''; BasePath: string = '');
    constructor Create;
    destructor Destroy; override;
  end;

var
  MVCApp: TMVCApp;

function StartServer(): string;

procedure CloseServer();

procedure StartWin;

procedure StartWinServer();

implementation

{$IFDEF MSWINDOWS}

uses
  MVC.Main;
{$ENDIF}

procedure StartWinServer();
begin
{$IFDEF MSWINDOWS}
{$IFDEF SERVICE}
  // 以windows服务形式运行
  if not Application.DelayInitialize or Application.Installing then
    Application.Initialize;
  Application.CreateForm(TWINService, WINService);
  WINService.setParam(MVCApp.Service.FSName, MVCApp.Service.FDisplayName,
    MVCApp.Service.FServiceType, MVCApp.Service.FStartType);
  Application.Run;

{$ELSE}
  log('没有声明【SERVICE】编译条件');
  Application.MessageBox('服务生成失败,没有声明【SERVICE】编译条件', '提示', MB_OK);
{$ENDIF}
{$ENDIF}
end;

procedure StartWin;
var
  hMutex: THandle;
begin
{$IFDEF MSWINDOWS}
{$IFNDEF SERVICE}
  if Config.isOver then
  begin
    Application.Title := '[' + config.Port + ']' + Config.AppTitle;
    hMutex := CreateMutex(nil, False, PChar(Config.AppTitle));
    try
      if GetLastError = Error_Already_Exists then
      begin
        log(Config.AppTitle + '已启动');
        Application.MessageBox(PChar(Config.AppTitle + '已启动'), '提示', MB_OK);
      end
      else
      begin
        if not Assigned(MVCMain) then
        begin
          Application.Initialize;
          Application.CreateForm(TMVCMain, MVCMain);
          Application.Run;
        end;
      end;
    finally
      ReleaseMutex(hMutex);
    end;
  end
  else
  begin
    log(Config.AppTitle + '配置文件读取失败');
    Application.MessageBox(PChar(Config.AppTitle + '配置文件读取失败'), '提示', MB_OK);
  end;
{$ENDIF}
{$ENDIF}
end;

function StartServer(): string;
begin
  Result := '-1';
  if Assigned(Config) then
  begin
    while true do
    begin
      if (Config.initParams) then
      begin

        httpServer := THTTPServer.Create;
        httpServer.Start;
        if httpServer.Action then
          Result := Config.Port;
        break;
      end
      else
      begin
        sleep(10);
        {$IFNDEF SERVICE}
        Application.ProcessMessages;
        {$ENDIF}
      end;
    end;
  end;
end;

procedure CloseServer();
begin
  if httpServer <> nil then
  begin
    httpServer.Stop;
    httpServer.Free;
    httpServer := nil;
  end;
end;

{ TMVC }

function TMVCApp.Command: boolean;
var
  LResponse: string;
begin
  Writeln('input ''exit:'' 退出服务');
  Writeln('input ''clear:'' 清理页面缓存');
  readln(LResponse);
  if LResponse.ToLower = 'clear:' then
  begin
    PageCache.PageList.Clear;
    Result := true;
  end
  else if LResponse.ToLower = 'exit:' then
    Result := False
  else
    Result := true;
end;

constructor TMVCApp.Create;
begin
 {$IFDEF MSWINDOWS}
  Service := TMVCWinService.Create;   {$ENDIF}
end;

destructor TMVCApp.Destroy;
begin
 {$IFDEF MSWINDOWS}
  Service.Free;  {$ENDIF}
  inherited;
end;

procedure TMVCApp.ReadIni(BasePath: string);
var
  inifile: TIniFile;
  f: string;
begin
  if BasePath.Trim = '' then
  begin
    f := WebApplicationDirectory + 'mvc.ini';
    inifile := TIniFile.Create(f);
    try
      BasePath := inifile.ReadString('ResPath', 'Path', 'false');
      if BasePath = 'false' then
      begin
        inifile.WriteString('ResPath', 'Path', '');
        BasePath := '';
      end;

      if BasePath.Trim = '' then
        Config.BasePath := WebApplicationDirectory
      else
      begin
        if (BasePath.Substring(BasePath.Length - 1, 1) <> '\') and
          (BasePath.Substring(BasePath.Length - 1, 1) <> '/') then
          BasePath := BasePath + '\';
        Config.BasePath := BasePath;
      end;
    finally
      inifile.Free;
    end;
  end
  else
  begin
    if (BasePath.Substring(BasePath.Length - 1, 1) <> '\') and
      (BasePath.Substring(BasePath.Length - 1, 1) <> '/') then
      BasePath := BasePath + '\';
    Config.BasePath := BasePath;
  end;
end;

procedure TMVCApp.Run(password, BasePath: string);
{$IFDEF CONSOLE}
var
  url: string;
{$ENDIF}
begin
  ReadIni(BasePath); // 用来检查资源路经是否为exe根目录
  initRoute;
  Config.setPassword(password);

  /// //////////////////////////////////////////////////////
  {$IFDEF CONSOLE}
  if Config.initParams then
  begin
  {$IFDEF MSWINDOWS}
    SetConsoleTitle(PChar(Config.AppTitle));
  {$ENDIF}
    url := 'http://localhost:' + Config.Port;
    Writeln(url);
    StartServer();
    while True do
    begin
      if not Command then
        Break;
    end;
    CloseServer();
  end
  else
  begin
    WriteLog('配置文件读取失败，请检查文件格式');
  end;
{$ELSE}
{$IFDEF MSWINDOWS}
{$IFDEF SERVICE}
  if Config.initParams then
  begin

    MVCApp.Service.Init;
    if (Service <> nil) and (Service.FSName = '') then
    begin
      WriteLog('启动失败，请配置服务参数');
    end
    else
      StartWinServer;
  end
  else
  begin
    WriteLog('配置文件读取失败，请检查文件格式');
  end;
{$ELSE}
  if Config.initParams then
  begin
    StartWin;
  end
  else
  begin
    WriteLog('配置文件读取失败，请检查文件格式');
  end;

{$ENDIF}
{$ENDIF}
{$ENDIF}
end;

procedure TMVCApp.Start(password, BasePath: string);
begin
  ReadIni(BasePath); // 用来检查资源路经是否为exe根目录
  initRoute;
  Config.setPassword(password);
  StartServer;
end;

initialization
  MVCApp := TMVCApp.Create;

finalization
  MVCApp.Free;

end.

